home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / tpdb13.arc / PACKTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1989-02-13  |  741b  |  36 lines
  1. Program PackTest;
  2.  
  3. Uses Crt,TPDB;
  4.  
  5. Var
  6.    H : Integer;
  7.  
  8.  
  9. begin
  10.      DBOpenFile('packtest.dbf');
  11.      If TotalRecs>=500 then Zap;
  12.      ClrScr;
  13.      Writeln('Appending 1000 records.....');
  14.      FillRecs(1000);
  15.      Writeln('Deleting 500 records....');
  16.      For H := 1 to 1000 do
  17.      begin
  18.           GetDBRec(H);
  19.           If H mod 2 = 0 then
  20.           begin
  21.           Repl(1,'Deleted.');
  22.           Mark;
  23.           end
  24.           else
  25.           Repl(1,'Undeleted.');
  26.           PutDBRec(H);
  27.      end;
  28.      CloseDBFile;
  29.      DBOpenFile('packtest.dbf');
  30.      Writeln('Packing....');
  31.      Pack;
  32.      Writeln('500 undeleted records remain.');
  33.      Writeln;
  34.      Writeln('TPDB Version 1.3');
  35.      CloseDBFile;
  36. end.